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LIST  OF  SYMBOLS 


See  Eq.  (5) 

bearing  deviation  gain 
aperture-corrected  bearing  deviation  gain 
sound  speed 

primary-pressure  beam  pattern 
primary  directivity  index 
difference  frequency 
primary  frequency 
see  Eq.  (3) 

shape  parameter,  see  Eq.  (Al) 

(-1)* 

2ft  f/c 
2"f0/c 

aspect  ratio  of  rectangular  projector 
peak  pressure  amplitude  of  difference  frequency 
peak  face  pressure  amplitude,  one  primary  component 
range  (from  projector  to  observer) 
source  point  distance 

Rayleigh  length,  projector  area/primary  wavelength  for  piston 
projectors,  projector  length/n  for  endfire  projector 
rms  source  level  of  one  primary  component 

SL0  +  20  log  f0 

20 1  og (p c3  /2rr  ,/25 )  +  60  dB//lyPa  -  m  -  kHz  (see  Ref.  14) 
see  Eq.  (6) 

variable  of  integration,  see  Eq.  (3) 
see  Eq.  (4) 

primary  wave  absorption  coefficient  (nepers/unit  length) 
primary  wave  absorption  coefficient  (dB/unit  length) 
nonlinearity  parameter  (sj  3.5  for  water) 
see  Eq.  (9) 

observer's  polar  angle  (with  respect  to  projector  axis) 
source-point  polar  angle  (with  respect  to  projector  axis) 
angle  between  source  point  and  observer,  see  Eq.  (2) 
ambient  fluid  density 

observer's  azimuthal  angle  (about  projector  axis) 
source  point  azimuthal  angle  (about  projector  axis) 
see  Eq.  (8) 
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ABSTRACT 

If 

Because  it  is  often  impractical  to  make  measurements  in  the  farfield  of 
parametric  acoustic  sources,  it  is  desirable  to  be  able  to  predict  the. far 
field  from  nearfield  measurements.  A  nearfield  beam  pattern  theory, 
previously  outlined  fa.  Acoust.  Soc.  Am.  63,  1622-1624  (L)  (1973)],  has  been 
programmed  for  digital  computation.  The  results  compare  favorably  with 
experimental  data  from  an  absorption-limited  source  involving  substantial 
difference-frequency  generation  in  the  primary  farfield  and  from  a 
saturation-limited  source  with  most  of  the  generation  taking  place  in  the 
primary  nearfield.  In  the  first  example,  the  nearfield  beam  pattern  is 
broader  and  the  apparent  source  level  is  lower  than  in  the  farfield.  In  the 
second  example,  the  nearfield  pattern  is  narrower  and  the  apparent  source 
level  higher  than  in  the  farfield.  ^ _ 
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INTRODUCTION 


In  experiments  with  parametric  acoustic  sources,  farfield  measurements  are 
often  impractical,  because  the  farfield  (the  region  where  secondary  signal 
generation  has  ceased)  may  be  as  remote  as  5/a  from  the  projector1  (a  * 
primary  absorption  coefficient  in  nepers  per  unit  length).  To  allow  farfield 
prediction  from  nearfield  measurements,  a  nearfield  theory  must  be  employed. 
Reference  2  describes  a  nearfield  model  and  outlines  a  computation  procedure. 
We  can  now  report  on  the  computer  implementation  of  this  procedure  and  some  of 
the  results  that  have  been  obtained  from  the  computer  program.  A  user's  guide 
to  the  program  (called  CONVOL)  is  given  in  Appendix  A  and  FORTRAN  listings  are 
given  in  Appendix  B. 

I.  THEORY 

The  details  of  the  theory  are  presented  in  Ref.  2.  The 
difference-frequency  pressure  at  the  field  point  (r,9,<|>)  is  given  by 


P(r,e,<j>) 


B(P„RJ<) 


2  TT 


(  d6/sin0/  f  d4>'D  2(0^  ♦)  I  (cosv), 

Jo  Jo  0 


where 


cosv  =  cose"  cose  +  sine"  sine  cos(4»"  -  $), 

I  =  exp(-jkr)  jg  dy  exp(-y)  U(OU2  +  B2f1/2, 


z  =  y-2ar  cosv  +  j2kr  sin<:(v/2), 

B2  =  (1  +  jk/a)(2ar  sinv)2, 
and  U(0  is  the  saturation  taper  function, 


(2r2)[(l  +  0(1  +  20  _1/2-  l]. 


In  Eq.  (6), 
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i"*  a  r  c'oso  +  (2b  )“*  1  +  jk/ct)'*  _ 

x  [(1  +  Jk/a*)z  -  (jk/2b)(z2  +  82)1/2J  ,  (10).< 

and  N  is  the  aspect  ratio  of  a  rectangular  projector  (N  =  1  for  square  or 
circular  shapes).  The  quantities  I,  z,  B6,  u,  £,  n,  and  r'  are  all  complex, 
because  the  integral  of  Eq.  (3)  is  the- result  of  a  transformation  in  the 
complex  plane5  of  a  highly  oscillatory  integrand.  Thus  the  method 
substitutes  the  complications  of  complex  arithmetic  for  the  slow  convergence- 
inherent  in  the  use  of  the  oscillatory  function.  For  example,  at  high 
amplitudes,  the  singularity  introduced  at  £  =  -1/2  must  be  dealt  with.  (There 
is  no  pole  at  5  *0,  since  U(0)  3  1.) 

Equation  (1)  is  a  generalized  form  of  the  convolution  integral  used  by 
Blue6  and  by  Berktay  and  Leahy’  for  the  farfield  of  absorption-limited 
parametric  sources.  The  integrand  involves  the  product  of  an  endfire  beam 
pattern,  I  (cosv),  and  the  square  of  the  primary  beam  pattern,  0o(9' ,  <p'  ). 

No  aperture  factor6  results  from  the  theory,  because  the  primary  beam  is 
assumed  to  be  spherically  spreading  from  the  projector  face.  Therefore  the 
program  makes  beam  pattern  plots  with  and  without  a  multiplicative  aperture 
factor. 

In  the  farfield,  Eqs.  (3)  and  (10)  can  be  simplified  as  follows: 


I  — * - ±*K-Jhrj -  f  dy  exp(_y)  u(s)>  (11) 

r  -«»  2ar  +  j2kr  $in^(v/2)  J 0 

where 

r"  - ►  y/ 2a  [l  +  (jk/ct)  sin2(o/2)]  ,  (12) 

r 

and  these  expressions  are  used  in  the  farfield  option  of  the  program. 

Since  the  computation  of  the  endfire  pattern,  I(cosv),  is  a  lengthy  one 
and  since  I  is  a  smooth  function,  225  values  are  first  computed  and  stored  in 
a  table  for  values  of  v  ranging  from  10-4  rad  to  3.14  rad.  In  the 
subsequent  integrations  over*<j>'  and  9',  linear  interpolation  is  used  to 
evaluate  I(cosv)  between  the  tabular  values.  (For  \>  <  10*4  rad  and  v  >  3.14 
rad,  the  endpoint  values  are  used.)  The  tabular  values  are  computed  with  an 
adaptive  Simpson  quadrature  routine,9*10  in  which  the  step  size  for  the 
integration  variable,  y,  is  determined  by  the  degree  of  success  at  local 
convergence.  The  integrations  over  the  azimuthal  angle,  and  the  polar 
angle,  9' ,  are  each  performed  by  48-point  Gaussian  quadrature  over  a  number  of 
sub intervals  depending  on  the  beamwidths  of  the  endfire  and  primary  patterns 
and  on  the  observer's  polar  angle,  9  -  Typical  running  times  to  generate  a 
beam  pattern  for  a  square,  circular  or  endfire  projector  range  from  about  1 
minute  for  easy  cases  (absorption-limited  sources  with  large  aR0,  i.e., 
sources  of  the  WesterveltH  type)  to  about  5  minutes  for  difficult  cases 
(saturation-limited  sources  with  small  aR0)*  These  times  are  approximately 
doubled  for  a  rectangular  projector,  in  which  case  beam  patterns  are  generated 
in  each  of  two  planes. 
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II.  EXPERIMENTS 

The  results  of  experiments  with  two  different  parametric  sources  are 
reported  in  Sec.  III.  The  first  was  rectanqular  In  shape,  with  active  face 
dimensions  of  0.53  m  (horizontal)  x  0.44  m  (vertical),  a  mean  primary 
frequency  of  24  kHz,  and  a  source  level  of  233.5  dB//lMPa-m  at  each  primary 
component.  The  difference  frequency  was  2.5  kHz.  Beam  pattern  measurements 
were  made  in  the  horizontal  plane  at  a  depth  of  49  m  in  a  f»*esh  water  lake 
(Seneca  Lake,  NY)  in  March,  1979.  The  range  was  42.8  m  and  the  water 
temperature  was  approximately  1°C.  The  Rayleigh  length,  R0,  was  4.0  m, 
aR0  m  O.OOldB,  and  20  log  x  a  -19dB.  This  source  generated  mucn  of  tne 
secondary  signal  in  the  primary  farfield,  since  the  absorption  parameter, 
aR0,  was  small. 

The  second  projector  was  circular,  with  an  active  face  d’mmt’  f  0.9!  e, 
a  mean  primary  frequency  of  65  kHz,  and  a  source  level  of  5  >*a-m  at 

each  primary  component.  The  beam  pattern  measurement  was  «eoe  eiSC  s 
Millstone  Quarry  facility  in  January,  1975  at  a  diff arence-f '•ee  f*cy  jf  1.5 
kHz.  The  measurement  range  was  82.6  m,  and  the  depth  was  15  m.  <*«r«  tne 
water  temperature  was  approximately  15°C  and  the  salinity  3.DI.  source 

was  saturation- limited  (x  «  1.0)  in  the  primary  nearfield,  i.e.,  substantial 
generation  of  the  difference  frequency  took  place  within  tne  Ray’eign  ’ength, 
R0  of  28.4  m.  The  amount  of  primary  absorption  in  the  nearfield,  W0,  was 
0.51  dB. 

III.  RESULTS  AND  CONCLUSIONS 

Figure  1  shows  the  beam  pattern  of  the  rectangular  source.  The  circles 
are  the  experimental  data,  and  they  may  be  seen  to  lie  fairly  well  on  the 
computed  pattern  i indicated  by  the  solid  curve).  Also  shown  (as  a  dashed 
curve)  in  the  figure  is  the  computed  farfield  pattern.  For  the  actual 
observation  of  such  a  pattern,  measurement  ranges  in  excess  of  5000  m  would  be 
required.!  It  may  be  seen  that  considerable  change  in  the  beam  is  to  be 
expected  between  the  measurement  range  of  42.8  m  and  the  farfield,  with  the  3 
dB  beamwidth  decreasing  from  6°  to  4.5°.  The  farfield  pattern  is  shown  at 
the  correct  relative  amplitude,  i.e.,  about  14  dB  more  source  level  is  to  be 
expected  in  the  farfield,  and  the  skirts  of  the  pattern  will  grow  about  4  dB 
in  level.  The  ripples  on  the  skirts  of  the  farfield  pattern  are  related  to 
the  square  of  the  primary  pattern,  characteristic  of  sources  with  small 
ctR0.*  The  amplitude  of  the  ripples  is  somewhat  exaggerated  by  the 
assumption  that  both  primary  frequencies  have  identical  beam  patterns, 
whereas,  in  fact,  the  outer  sidelobes  will  not  coincide,  resulting  in  smoother 
skirts  than  depicted  here. 

The  results  with  the  circular  projector  in  salt  water  are  shown  in  Figure 
2.  Again,  the  data  are  shown  as  circles,  while  the  solid  curve  is  the 
computed  nearfield  pattern  and  the  dashed  curve  is  the  computed  farfield 
pattern.  In  this  case  of  moderately  high  aR0,  the  nearfield  source  level  is 
2dB  higher  than  that  which  would  obtain  in  the  farfield  and  the  nearfield 
beamwidth  is  narrower  than  its  farfield  value  (2.50  an<j  40^  respec¬ 
tively).  The  skirts  of  the  patterns  coincide,  however,  because  the  farfield 
conditions  are  reached  much  more  quickly  on  the  skirts  than  on  the  maximum 
response  axis.  Ranges  in  excess  of  700  m  would  be  required  to  observe  the 
farfield  pattern  in  this  case. 
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The  fact  that  nearfield  beam  patterns  can  be  narrower  than  their  farfield 
counterparts  for  parametric  sources  with  large  aR0  has  been  recognized  for 
some  time,  12, 13  but  only  more  recently  has  it  come  to  light  that  the 
apparent  source  level  can  be  larger  than  the  farfield  value. it  is  now 
obvious  from  our  computer  studies  that  the  source  level  and  beamwidth  effects 
are  tied  together.  For  cases  of  large  otR0,  the  nearfield  pattern  is 
narrower  and  of  higher  apparent  source  level  than  the  farfield  pattern.  For 
small  ctR0,  the  nearfield  pattern  is  broader  and  of  lower  source  level  than 
in  the  farfield. 

In  Refs.  3  and  4,  a  simple,  closed-form  expression  was  suggested  for  beam 
pattern  estimation.  Figure  3  provides  a  comparison  between  that  simplified 
model,  shown  dashed,  and  the  present  theory,  shown  as  the  solid  curve,  for  the 
farfield  of  the  65  kHz  projector.  It  may  be  seen  that  the  simple  formula 
predicts  a  3  dB  beamwidth  (5.5°)  which  is  too  broad  (computed  value  =4°) 
but  provides  a  reasonable  fit  to  the  skirts  of  the' pattern. .  As  discussed  in 
Ref.  3,  some  error  near  the  3  dB  points  is  to  be  expected  in  the  use  of  the 
simple  formula,  because  the  formula  was  constructed  from  knowledge  of  the 
large-angle  behavior.  The  present  theory  is  to  be  preferred  for  all  but  rough 
estimates  of  the  beam  behavior. 
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APPENO.IX  A.  CONVOL  USER'S  GUIDE 


The  CONVOL  program  computes  parametric  source  beam  patterns  out  to  45° 
for  plane  piston  projectors  of  circular,  square,  and  rectangular  shape  and  for 
endfire  line  projectors.  The  program  generates  a  table  and  plots  the  negative 
of  the  bearing  deviation  loss,  denoted  BDG,  as  'veil  as  aperture-corrected 
values,  BDGAP,  as  a  function  of  the  polar  observation  angle,  "9,  with  respect 
to  the  maximum  response  axis.  For  a  rectangular  projector,  plots  are 
generated  for  each  of  the  two  prinicpal  observation  planes  at  <t>  =  0  and  <t>  = 
90°,  where  <t>  is  the  azimuthal  observation  angle.  In  addition  to  the  beam 
patterns,  the  program  computes  the  on-axis  apparent  parametric  gain, 
201og(rP/RoPo),  i.e.,  the  difference  between  the  apparent  secondary  source 
level  and  that  of  one  primary  component.  Since  the  apparent  parametric  gain 
can  be  regarded  as  a  complex  quantity,4  its  phase  is  also  computed  and  the 
result  tabulated  as  a  function  of  9. 


The  user  must  specify  the  projector  shape  through  the  integer  parameter 
ISHAPE: 

ISHAPE  *  0:  circle 
1:  square 
2:  rectangle 

3:  endfire.  (Al) 

The  parameter  ISHAPE  is  also  used  to  indicate  the  end  of  the  input  data  file. 

A  negative  value  of  ISHAPE  causes  the  plot  tape  to  be  properly  terminated  so 
that  plots  can  be  generated  off  line.  The  other  input  parameters  are:4 

201ogx  =  SLg*  -  SLi,  (A2) 

i.e.,  the  difference  between  the  ''scaled"primary  source  level, ^ 

SLo*  5  SL0  +  20  logf0  (kHz) 

and  the  value,  SLi*,  which  corresponds  to  shock  formation  at  Ro  (SLi*  « 

281  dB//l  pPa-m-kHz  for  sea  water^), 

aRo(dB), 

the  amount  of  primary  absorption  loss  at  R0, 
fQ/f , 

the  "downshift"  ratio  of  the  primary  and  secondary  frequencies, 


k  R  =  i 
oo  2 


X  10 


(DIo/10) 


> 


where  DI0  is  the  primary  directivity  index. 


r/R0» 
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the  ratio  of  the  observation  range  to  R0,  and  finally, 3 
N, 

the  aspect  ratio  (required  only  if  the  projector  is  rectangular) . 

The  Rayleigh  length,  R0,  is  defined  as  the  projector  face  area  divided 
by  the  primary  wavelength  for  the  plane  piston  projectors  and  as  the  projector 
length  divided  by_ir  for  endfire  projectors.  The  program  has  been  tested  for 
201og  x  <.  10  dB,  aR0  >  0.001  dB,  and  ,-100  <  r/R0  <  +100. 

Typical  runstream  examples  are  given  in  Figures  Al-AU  for  operation  of 
CONVOl  on  NUSC's  Univac  1108  computer  from  a  Tektronix  graphics  terminal.  The 
first  input  data  card  specifies  the  projector  type  according  to  the  value  of 
ISHAPE  in  an  15  format.  ISHAPE  =  l(square)  in  the  first  example  and 
2( rectangie)  in  the  second.  The  second  data  card  provides  the  source 
parameters,  201ogx  (dB),  ctfi0  (dB),  f0/f,  k0R0,  and  r/R0  in  five 
15-character  fields.  (The  negative  value  of  r/R0  in  the  second  example 
specifies  infinite  range.)  The  decimal  points  may  be  placed  anywhere  within 
their  respective  fields.  If  the  projector  is  rectangular,  as  in  the  second 
example  another  card  is  needed  to  specify  the  aspect  ratio,  N,  in  the  first 
15-character  field. 

Each  example  is  concluded  with  a  negative  value  of  ISHAPE  to  generate  the 
plotting  tape.  Actually,  both  examples  could  have  been  run  together  in  this 
case,  i.e.,  the  tabulation  from  the  first  example  could  have  been  followed 
with  ISHAPE  =  2,  for  the  next  example.  If  there  is  any  doubt  about  whether 
there  is  sufficient  time  to  complete  all  examples  of  a  run,  however,  it  is 
safer  to  terminate  each  example  with  a  negative  ISHAPE. 

In  each  of  these  examples,  plots  were  displayed  first  on  the  terminal  CRT 
with  the  @  XQT  0. TEKTRONIX  instruction.  They  were  then  transmitted  for  later 
printing  to  a  1  inch  *  10  dB,  1  inch  =  10  deg  scale  with  the  3  XQT  D.FR80 
instruction.  Note  that  these  instructions  were  preceeded  with 
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APPENDIX  3.  CONVOL  FORTRAN  LISTING 

The  various  elements  of  CONVOL  are  listed  on  the  following  pages.  The 
main  program  calls  subroutine  QGM48,  which  generates  coefficients  for  the 
Gaussian  quadrature,  and  subroutine  TABLE,  which  stores  the  real  and  imaginary 
values  of  exp(jkr)  I(cosv)  in  arrays  VALUE1  and  VALUE2,  respectively.  TABLE 
does  this  by  calling  function  ADPSBC,  the  adaptive  Simpson's  routine.  ADPSBC 
requires  integrand  evalutations  from  the  function  FNC,  which  in  turn,  calls 
UEVAL  for  the  evaluation  of  U,  the  saturation  taper  function.  When  TABLE  has 
completed  its  job,  the  main  program  performs  the  integration  over  q' ,  using 
the  coefficients  generated  by  QGM48.  The  d'  integrand  evaluations  and 
integrations  over  are  done  by  subroutine  FCTPHI,  which  evaluates  the 
integrand  by  interpolation  of  the  table  stored  in  VALUE1  and  VALUE2.  The  beam 
pattern  data  is  stored  by  subroutine  MMSTOR  and  plotting  instructions  are 
generated  by  MMPLOT. 
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:  2 1 

THIS  PfiUoR!v  COMPUTES  ’rhE  ‘.'£4S  F  IEU0  PARAMETRIC  CAIN  RP/R  "PC1  AS  A 


function  Or  CoSEkvatic.*  angle  t^eta.  max  run  ti*e  =  20  min. 
UfapROJECTO?  APEA/PRJ^ARt  -A  VE  uEf.GTH  Fort  CIRCULAR  .SQUARE,  AND 
rectangular  rrojectcrs.  r^pko  jectop  length/pi  for  enofire  Case.) 


E 

.‘.‘OLE 


3  E  iV  0  F  I  0  E 
.LT.-C  STCP 

CHIOB  =  ?ClCG10CChI  )  (OB) 


alfaru=ailpha*r:  ( 0 w  ) 
DO«.NSR-F~/F 
R J  K  j  =  < 0*»0 


XAX=*C  t)9 


MIN*';,? 
M  I  N  *  2  •  t‘ 
!*  I  K  *  "  .  4 


ELO  GAIN 


outputs  rx-kr 

const 3= <chi/pi) **2 

T*OALF=i*ALPHA*R 


PH  !R  =  ?n  I  tfiACi) 

C  Tn=COS (ThETA) 


6  A  IM(Ofc) 
PnASE (0c5) 


COM MON /OCR Ac/  ChI0fc,ALFARr,0CWNSR,6AIN,FASE.NAPFAC 
co.*!mon/nht/:(2d,-(:i.) 


CALL  <3  G  : 


f  0  R  .1 «  T  ( 1 5  ) 

IF  (IShAPE  .LT  ,C)  GO  to 


B-2 


•PI/tNN 

:  =  C  .  5 *  *  3 
*F I-=h ALF 


CALL  PSOCCi 


I T  E  G  S  A  l  FRO-1  BwEFk  TO  PI/2: 
.2  1  s  =  C;»5*PI~a*>£FK)/ENh 


s  t.  •  5  *  5 
A  =  J  .  5*PI-cHALF 
0  0  K27  J  = 1  »  N  T  H  &  T  A 


Call  PF.0CG1 

A  -  A  —a 

27  CONTINUE 


»'.S  :  =  A  N  S  3  *  6 
A\ j2-ANS4 *E 

IN  FEuS«L  F30>«  C  TO  BWEFrt: 


n  .  ^  =  j  •  . 

*NS 4=0.0 
G  =  o  v»  i  F  9 


=  »  •  3  *e 
A  =c hnL F 
C  1  LL  PPOCL'I 


1  T 

K  S  _  3  A  N  3  2  +  A  N  S  4 
0  TO  1 03  A 


C  I  A  f  I  ) 

TA-K 

s.o  l  =  i 


3  C  .5*3 

*P i-bhalf 


TrlETArf)  /DBlL 


:tTnET**r.  ~  i  i  »c  icr  p.  )/  5n  At 
!AlF*0.5*b 

sTrtiTAP«C.  j*fe»iF9-aKALF 
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A  N  3  2  s  A  N  S  A  *  E 

I,\TcisPmL  FRO*  (PI/_-9v.EFR)  TO.  PI/ 2: 


E.FR 


•  si  ,i*Fl-5HALF 
.  A  uL  PACCC" 


h\ 3  ,--ANbi*C 

ANS  a-A;,SA*5 

ACCUMULATION  FOP  7  v  T  A  L  INTEGRAL: 


1  SJ 

2=ANS2+ANSA 

5  L  s  A  J  A  1  (  a  f,  S  A  »  A  N  i  1  ) _ 


HA  S  E  / 

.  ,GT.1)  jO  TO  1C2G 

",*-lOG1  :(a\S1*ans1>ANS2*ANS2) 


i  ;  -  P  h  A  a  E 

, =  R  S  A  I +  1 C  .  *  ALO  G  'i  C  (  C  0  E  F  F  *  C  0  E  F  F ) 
::.T  1?  GAIN 


S 


IFClihAPE.Ev.. I  jr.  «P£.ea.i)  GO  TO  KH 

A'\i  !  ’,  =  $  <3  R  T  (  _  #5* *  rOKu-»?I)*STh  /  C  0  «  N  S  R 

ifcishaos.sc.1)  go  r:  1015  _ 


RTAG  =  SGKT (ASPEC  T) 

IF  IPhIR  .EG . C.O)  GO  TO  1C  I  6 
AkSMsARG  11*RTAS 


s 

ARG  1  1 


u  1  “  1  ?. 

l=SQaT(«:.0*S0KC)»STH/3OW%Sf< 
st.C*aS£L(AnGl 1  ,  I)/*RG1 1 


THETAS  **2 ) /OOWNSR 

RG  1  1 


V 

\ 

* 

THETA,=OG,bCGAP,PrtASE,.'tPHl 


*  ,lxf  ft  71 , 5  X ,  F 
,C  uG A  P  ) 


f  6X  f I  4 ) 


I .  r  r  r  y,  -  G 

call  p>.plgt 

f ipF4C=1 


CAll  “ r  L 0 T 
IFCF’nlR.EG.  . 
GO  TO  1021 


Z)  GO  TO  10C2 


W  i  VJ  I 

ED  ORE  PRCC01 
osRCUTI’.c  FRCCol 


rt  A  L  r  *  C ( I) »  A  R  G  1 t A  R G  d ) 


'n.S'il'IUMLJil  i  i 

%i's»NS2+vU)*(ASGA  +  «RG1)*C.5 
*.,»<.sAfcS4-».C:>*lAR&4*AhG2)*'?.5 
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• 

>3  L  £ 

23-05  :  5  3  :  4;j-(C  , ) 

SUBROUTINE  i AcL : 

C  TrtlS  SUBPROGRAM  TABULATES  £  X  P  (  J  a.R  )  »  I  (  C  0  SNU  )  ?0*  *  .  CO0 1  .  L  c  .  GNU 

C  3.14,  WITH  REAL  PARTS  STORES  I  N  VAlUEI(n)  AMO  IMAGINARY  3aRT3 

C  5  TOR  E  y  IN  VALUES  <M).  T«S  iNffeX  N  IS  R£lAT£3  TO  GNU  3r 

C  GNU  =  FLOAT(S)  /1COOC  I.LE.n.LE.  1C 

C  FL0AT(N-9)  /1C0C  IC.Lc.N.Lc.  19 

C  FL3A  T ( N-1 a )  /  ICC  1?.Uc..n.l£.11S  . 


C 

c 

c 

c 

c 

c 

c 

c 


( 


I 


FlOA  T (n-6£  )  / SC  11S.Ls.N.L£.’25 

COSNU  IS  NEGATIVE  POfi  GNU.5T.PI/2. 

INPUTS  t. galf*2*alpha«r 
R  K  *K  R 

RAn6E*R/»C 

Outputs  uC  *twoalf*cos.nu 
vc*kr*(1-cosnu) 
consti *co$nu*r/ro 

VALUE1 (225) 

V  A  UUE2 (225  ) 

AKCTALs*LPHA/ (2*K  ) 

BSG*8»*2  (COMPLEX) 

EXTERNAL  PNC 
COMPLEX  3  SO 

COMMON/3LX/UC,VC,TwOALP,R< 

COMMON/ TAN/ RANG  fc 

COM. ION  /  RED /V  ALU  cl  (  2  40  )  ,  V  ALUE  2  (  24  0 
COMMON / 9R0w N / C 0 NST 1 .AKCTAL 
Common /GRn/x (23  ) , V ( 2 3 ) 

COMMON/ PUCIA/9S  « 

T* A  X  *20  . 

EPS  I *0.5 £-02 
30  201  ,n *1,225 
If(N-IC)  203,203.204 

203  GNU*PL0AT(N)*1 .Ls-04 
GO  TO  205 

204  IPCN-19)  2Ca, 20e,209 
20a  GNUsfLOAT (n-9) • 1.0E-C3 

GC  TO  205 

209  IP (N-1 13)  212,212,213 
212  b.‘.U*?L0AT(N-1S  )  .C.C1 
50  TO  205 

212  GNU*PL0AT(N-«3)  »0.C2 

20 5  CCSNU*COS (GNU) 
uc*t»oalp  *CCSNU 
vC*Rx* ( 1 .O-COSNu) 

IP  (N.LT  ,19)  VC3RX*((GNU«-*6)/72C,-(GNU**4)/24.m0.5*(5NU**2)) 

CC.NST1*C0SNU»RAnGE 

AxOTAL*RK/T‘.OAL  P 

3Sa*CMPLX(1.0,2.u*AA0TAL)*(T-.0ALP*-»2)*((SIN(3NU))**2) 

A  *  U  .0 
3  *T  m  a  X 
E  *  E  P  S  I 

VAluEI  (N)*A0PS8C(A,3,PNC,1  iE.NPI) 

a  *0  . C 

S*TMAX 
E  *S PS  I 

VALu£2(N)*AiPSaC(A,3,PNC,2,E,AiP2) 


L  c  • 


TM  No. 

791132 
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n n  noon  o  o  o n  o 


TM.  NO. 
791132 


V 


>  3  I  ••  • u 

•DPSSC 

V23-C3:54:07-(0f) 

FUNCTION  A  0  PS  3  C  (Ai9,fNCilN6£X,tf»S*NP) 
C********««proSAA«PSO  ar  f*.  J.  SOLOSTtIN *•*»••*••* 
c •  **.**«• •**•*. *....«  ••*••.*......•« 

C*«**«THIS  SINGLE  PRECISION  SUBPROGRAM  APPROXIMATES 
**•*•  InTEGA  AL  FROM  A  TO  5  Of  THE  FUNCTION  FNC  (  *  ,  INO  EX  )  •*•  «* 
**  **• TO  '«  I T  H  I  N  A  PEL  A  T 1 V  6  ERROR  EPS  9  T.  ADAPTIVE  St"PS0N«»«* 
«***«LUADRA7UAE  AMO  RETURNS  The  A  PP  SO  AIM  ATI  ON  IN  AOPSbC.*** 
*****  THE  fUNCTION  FN  C(  A  ,  IND  *  A  )  IS  A  SINGLE  PRECISION  ****** 
•’•••EXTERNAL  FUNCTION  SUBPROGRAM  HhICH  EVALUATES  THE  ***** 
•••••FUNCTION  AT  POInT  A.  INDEX  IS  A  POINTER  TO  ONE  OF  «••* 

•••••several  intesranos  contained  in  the  code  of  •***.. 
•••••fnc  (x.inqex),  n P  is  returned  to  the  CALLING  PRU-  **••* 
*..**G6AN  a  S  ONE  LESS  than  The  NUMB  c  r  of  integrand  EVAL-  •* 
..**.UATI0NS  USED  TO  OBTAIN  ThE  RESULT  AOPSdC.  .**•« 


DIMENSION  SPSP( 30) . F2(3C>  »F3 (30  » fmp(3J) ,XN< J9) ,F3P<39) ,dX(3C) » 
•A2 (30) ,xl C33) , E  ST2( 39) , ITRN<39) , PVAL(3C,2) 

LOGICAL  TEST 

cora  * 

N  P  3  0 

EPS  3  15. 9* EPS 
LVL  3  9 
A  8  S  A  =  1.0 

est  3  i  .o 

OA  *  a  -  A 
FA  *  fncca, INDEX) 

Fr*  *  4.0*fnc((a  ♦  a>*c.s, index) 

F=  =  FNC(a, INDEX) 

NP  S  2 

ASSIGN  20G01  TO  PROC01 
SO  TO  3G0G1 
2CGQ1  CONTINUE 
2CC02  CONTINUE 

IF(. NOT. (TEST))  SO  TO  2GQC3 
LVL  3  LVL  -  1 
ICOl  *  ITRN (LVL  ) 

PVAL(L7L»ICCL)  3  SUN 
assign  20C05  TO  PR0CG2 
SO  TO  393C2 
2 r L 0 5  CONTINUE 

GO  TO  2  G  Q  G  A 
2C3CI  CONTINUE 

I  TAN (LVL)  *  1 
DA  s  OX (LVL ) 

FM  3  F  2 (LVL) 

F  5  *  FMP(LVL) 

EPS  *  E°S P ( LVL ) *0.5 

EiT  3  e  ST  1  i  SAVE  3  POI>T  APPROX.  ON  (A,  A  ♦  0  A  ) 

ASSIGN  2 0 0 C o  TO  PP0C91 
SC  TO  20031 
2 COG D  CONTINUE 
2CGCA  CONTINUE 

I  F  C  •  NOT.  (LVL.  EG.  D)  GO  TO  29C92 
A3PSSC  3  S.j."  -  C0RR/15.G 
RETURN 


TM  No. 

,791132 


?  ft  o  c  £  u  s  £  a  s  c  u  a 
CONTINUE 
LVL  »  LVL  1 
3  X (LVL)  *  0  A  *0  •  5 

5  X  *  0  X  (  L  V  l  )  /  6  .  C 


F3UVI)  * 
EPSP (LVL) 


X,a  (LVU)  *  A  *  D  X(LVL) 

X2<LVU  *  A  *0  X (  LVL)  *0  •  5 
F2(IVL)  a  ;.C*f  .NCCX21LVL)  ,IN0£X) 

X3(LVU>  a  X2(LVU)  ♦  DX(LVL) 

.  F  3  (LVL)  *  A.3*F.\C(X3(LVL)*IN0SX) 

EPSP(LVL)  a  £ p S 

TOLeSANCc  *UST  aS  .  ST .  1S/C2«*27)  TO  AVOID  NOISE  PROBLEMS: 

IN  NEXT  STATEMENT,  lVL.NAX  IS  SUCH  THAT 
Ci«»LVL.NAX)  .LT  .  (3l*S07*EPSI) 

I F ( Lv  L  .ST  •  2  U )  EPSP(L*L)*1 .CE-07 
FNP(LVL)  =  ?N*0.25 

£  S  T 1  *  (FA  ♦  F2  (LVL)  ♦  FHP(LVL))*SX 
FSP(LVU)  *  F9 

E  S  T  2  (  L  7  L  >  a  (F*?(LVL>  *  F3(LVU)  ♦  F3)*$X 

S UiN  a  £ST*  ♦  E3T2CLVL)  3  STOSS  3  POINT  APPROX.  IN  SUrt 

A3  3  A  a  a  3  S  .A  -  AoK-ST)  +  A3S(EST1)  *  Ac  S  (  E  S  T2  (  t_  VL  )  ) 

Cl  a  =ST  -  SU.-a 

TEST  =  A3SICI)  .Le.E?SP(LVL)«A8SA  .3  SET  COMPAS ISON-  TEST 

TEST  =  TEST. AND  .(EST.NE.1 .0) 

TEST  a  TEST. OR. LVL. SE. 50 
IFtTSSTKOSR  =  CCSR  *■  Cl 
NP  s  NP  *1 
SO  TO  PRQC01 


PSOCEOJRE  CaS 
CONTINUE 

SO  TO ( 2GC07 ,  2GQ  C3 ) ,  ICGL 
CON  TI.NUE 
I T  a  N  (  L  V  L  )  =  2 
DA  -  0 X ( L  V l ) 

FA  a  F  .1 P  (  L  V  L  ) 

F  .a  a  F  3  ( L  V  L  ) 
r  S  a  ?  9  P  (  L  V  L  > 

EPS  =  E PSP (LVL) *0.5 
a  a  A,-*  (LVL) 

EST  =  E  ST2  ( s.VL  ) 

ASSIGN  20010  TO  ? A 0 0 0  i 

GO  TO  50001 

CONTINUE 

SC  TO  2 - u  t 

CCNT  INy.® 

SUN  a  PVAL(wVL.I)  *  P  V  A  L ( L  V  L  *  2  ) 
CONTINUE 

so  *0  psocc: 

£  :i 
■10 


onnnnnnnn 


9  I  N  44 


23-08 :54:25-(0») 

FUNCTION  F  N  C  (  Y  r  IN  0  £  X ) 

C  THIS  SUBPROGRAM  CON  P  UT  £  S  T  H  £  IN  T 
C  U*EXP(-Y)/SiRT(Z»*2*9**2) 

U»£XP(-Y) 

inputs  t 

INCEX*1  0  9  2 

U0*T'*OAL  f  »cosnu 
V  0  3K  R  •  (  1  — C  C  S  N  U  ) 
range 
0sa*a**2 

OUTPUTS  RT3SaRT<Z**2*d««2) 
FNC(r,1)»RcAL  part 
c  FNC(T , 2) «I*AG1NAR  Y 

COMPLEX  *T,i,U,  ?3.8$G 
CONNON/aLX/UO  »VC*THOALFt«X 
CON NON/TAN/PANG  £ 

CON NON/ ORANGE/ 9 T 
COMMON/ FUC I A/3S a 
IF(RAN6S.l  .0.0)  GO  TO  AC  1 
Z3C*PLX  (Y*UO»-v  C) 
PT*CSaR7(Z*»2>5Sa) 

"  CALL'UE’VAl.CT.Z.U'J 

Y33U*C.'1PLX  (£XP  (  -Y  )  ,0.  ) 
IF(INOEX.SQ.I)  FNC»R£AL(Y3) 
IF<lN0EX.£a.2)  FNC»AIN*G(Y3) 
RETURN 

401  Z*CMPLX (Y-U3, VC  ) 

RT»CS3RTCZ**2+6  SO) 

CALL  U£  V  A  L  (  Y  ,  Z  ,  U) 

Y3SU*CNPLX (£XP( -Y) ,0.) /RT 
I  F  ( INDEX  .£0.1)  FNC»k£AL(Y3) 

I F ( I  NO  £  X • £  3  •  2 )  FNC»AIpaG < Y3) 

RETURN 

£‘.0 


GRAND 

IF  RANGE. GT. 
IF  RANGe.LT. 


(COMPLEX) 

(COMPLEX) 

PART 


43  O 


n  r»  r»  •*» 
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5*: 3 

i  ;3»ouT:>u  wSv  *lCy  ,  i,*j) 

cc  - •  j r  =  s  sa~l ration-taps. a  l*  (R'/ro. 

: s ? o : $  y  (ait?  only  if  <oNii2.uT.Zi a oj 

1  0  C  U  S  £  5  ONLY  IF  a  ange .lt . z  spo) 

■  L  (  C  jMP'.;  X  ) 

C  j  \3  7 1  sCCi‘<U*a^\Gi 

CjnST3*WC*I/3I)  *»2 

*T=S;RT( !«*2*8  »«2)  (CjFPLEX) 

T.tAL:*2»AU?HA»n 
h  A  .ifi  £ 

ASPECT 

A  A  CTAU*ALPHA/ ( 2*<  ) 

ISnAP£*C,  1  ,2, OS  3 
s  S  0s  S  *  *  2  (COMPLEX) 

JuTPCiT  J  (COMPLEX) 

COMPLEX  AT, Z,u,=3 .APRILS, XI, 3S., DELTA 
CiMON/3LK/UC»VC.TWOALFf*K 
OM  NON /TAN/  n  A  NS; 

0.»MCN/3LUS/*SPsCT,iSHAP£ 

CHNCN/ YSLLO*/ C 0NS73 
C  0  N  C  N  /  3  A  0  '•  N  /  C  0  iSTI  ,  A  <  C  7  A  L 

ccn'Cn/crange/a  t 

COMMON /FUC  I  A/93  . 

CHIOS  .LE .-J? .  SET  U  *  ( 1  •  C  » G  » 0 ) 

IFCCCNST3  .UT.1  .Oc-Cw)  SO  TO  ICl 
zT£ST«CAasiz-ar)/CAjs(z> 

RPR  I. N£  =  CNPLX  C.  ,AX  0  T*L  )  •Z-C**P<.X  (  0.  ,  AKOTAL  5  -  AT 

IFCTSST.Us.G.CY)  RPAI»*S*Z*((1.lC.)-CMPLX(0.t.5*A<CTAL)* 
•(OS<./Z*»2)-<.2j,C.)«((  =  3a/:**2)-*2)>(.125,C.)»((i3S/Z**2> 
33a  ImS-A?SI>£*C  :*PLX  (  (a  »NG£/T*OALF)  ,C.)  ,'CMPLX  ( t  ,  ,2  .*  AkiOTAL) 
IF  <  a  A  NS  5  .LT  .:.G  )  aP,?IM  =  *CM?LX  (  PANGE  «Y  ,  C  .  )  /  CMPLA  (T.C  AlF  ,  VO) 
Le ( RANGE  .GT  .0.0  )  aPAl»c*SPai?*E*CMPU'/<C0HST1,3.) 
is(  (shape. ne.Zj  33  =  flP»:re*>csiar((i.,C.)  +  RpaiM2.*2) 
•PCiiHAPS.sv.O;  39=(C2.,C.)»*PRIM£«CMPLX(A$PEC7-1.f:.)*(2. 

•  cs;Hr((i.,0,>-»'C.'PLx(A?P5CT»i,,:.)*ap«i''€  +  apa:*,5«*2)) 

•  /  CMPL.X  (  1  .  tA  SPEC  T,  0  .  ) 

x  isi;.*?lx (co>iS7i  ,o. )  •  (clog (53 )* *2) 

IF  (  '.  A  3  S  (SPRIM;)  ,LT.  :  .  1  .AND  .  I  SHAPE  .  N  E  .2  )  X  I  *  CM  PL  X  (  C  0  N  S  7  3 , 0  , 
»((.075,0.>«(a?aiME*-*5T-CP3LX(l./6.,C.).(RPRi,'«E««3)MFP9I-E) 
IFCSHAPE.N6.2)  GO  TO  103 
OELTasCMPLX  iO.S  •(  A  SPEC  7-1  .0)  ,0.0 

I  F(CA3S  CRpa  I  ME  )  ,lT.;,1.ANC.CABs(0sLTA).lT.0.'j2)  XIs 
»  C  M  P  L  X  (C0S3T3  » u  .  )•  (  I.'iPLX  (  A  L  3  G  (2  •  /  (1  •♦ASPECT)  )  ,0  •  )  ♦DELTA  .RPR 

•  -<.5,:.)*JELTA*»2*(O«LTAfRPPI?«E)*(0£LrA*-»2-(2.,0.)*OELTA 
•«  R  PR  IM  S -a  ?RI«S*«2)/(J. »•■).)-(. 25. 0.)»0£uT  A  ••%♦(. 2. 0.)*(3SLT 
*♦’«  3  i,M  s  )  •  C  0  EUTi  »«  A-R?  S  I  Mg  *3  =  LT  A**  3*  (  0EW7A-’RPR  I  »£)  *  «  2*  (  1  .  5  . 
»*OSwrA.RPSl',*.*3*(.j75fO.)*RPRi.*E*»A))«-»2 

3  I?(CA8S<Xi)  .lT.  1.C2)  GO  TO  1C2 
XiT2ST*CA3SK1..0.)*(2.,0.)«'(I) 
iF(x;*sS7.Lr.i.:£-i-)  .  *  c  ( i . ,  ? . )  ♦  x ; ) « <  i ,  0 .3  C  9 , 3 . 5 
IFCxiTSST.GS.I.OE-1  : .  AND  ,  •<  IT'3  7  .LE  .0  1 )  U»  ( (1  .  ,  0  .  >  *X  I )  /  C3 
'  (  C  M  P  L  X  ( 9 , 3 1  /  X  :  T  sS  7  ,  •  . )  .  (  ( 1  . ,  : .  j  *  ( 2  ,  ,  0 . )  ••  X  :  > )  -  ( 1  .  ,  3  . ) 

I  F  (  X  I  r  £  S  7  .  G  ;  .  0  .  1  )  =  t  ( 1  .  ,  .  V  ♦  1 1  )  /  C  S  ii  R  7  v  (  1  ,  ,  3  .  )  ♦  (  2  .  ,  0  .  )  *  <  l 

«-( ’ . ,0. ; 

„  =o  *  ( 2  . .  C  .  5  /  C  x :  *«  Z  ) 


..}))) 


V 
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RETURN 

192  U*(1.,Q.)-<2.,C.i*x;-M3.75,0.)«<XI**2>-<7.,0.)*(J(I**3) 
RETURN 

101  U*(1.*0.) 
return 
ENO 
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2  3  -0  3  :  5  5  : 0  2  -  ( 3  » ) 

SUbaOUTINE  4GP4; 

C  this  SU3P«0to*A*  C0fP‘jT£s  WEIGHTING  FACTORS  FOR  the 

C  iUAOPATUR'. 

CO)1HON/wHT/C(24),«(24) 

C C1)s. 59377131 
C  C2)=. 9935301 7 
C(3>*. 93412453 
C(4)». 97059159 
C  < 5 )». 95296770 
- CC6)*. 93133669 
C(7>». 90537914 
C(3)». 37657202 
C(9)*.34353a26 
C  < 1 0  J  *  » 1070662: 

COD*.  7671  5903 

. .  '  C  02)*. 72403413 

C(13)». 67737233 
C (14)*. 62686743 
COS)*.  57722473 
C O 6)*. 52316097 
C ( 1 7)*. 46653290 
‘  COD*.4Ci63643 
COD*. 343  75539 
C (20>*. 23730249 
C  (21  )  =  . 22476379 
C(22)=. 1&122230 
C  <2D*.97CQ4699  £-1 
C(24)=. 32330771 £-1 

•  O  )*.  31  533^612-2 
•(2)*. 732 75 539c -2 
* (3)*. 114 77235£-1 
* (4) =.155 7931 6 s-1 
w  ( 5  )  * .  1  96  1  6  1  6C  2  -1 
9(6)*.2357076l£-1 
*(7)». 274265103-1 
•(3)*. 31167223s -1 
w (9)  =  . 347772235 -1 
w(10)*. 33241351 £-1 
wO 1 )*.4 154 5033 £-1 
- (1 2)*. 44674561 £-1 
w<13)*. 4761 66532-1 

•  04)*. 5035  ?036  c-1 
w0  5)*.52S9C139s-1 

•  06)*. 55199504  £—1 
w  07)*. 572  7729  2  e-1 

•  05)*. 591143405-1 
■  O9)*.607C4439  s-1 
w(23)*. 62039423 t-1 
'•(21  )*  .631  1  4192  £-1 

•  (22  )  =  .6392-239  £-1 
*(23)s.64466ls>.s—  1 

•  (24)*. 64737697  £-1 
»=TuRn 

c.N  3 


3  A0  3  3 1 A  n 
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23-08  :55  :l6-<0,> 

SUaRuUTIME  FCT( a«S,ARG1 ,ARG2) 

This  SUBPROGRAM  COMPUTES  THE  THfiTAPRIME  INTESRANO 
SIN  (THETAPRI.lE)  *  0  0  *  *  2  *  ( INTEGRAL  OVER  PHIPRIME) 


INPUTS  ST«*SIN(TH£TA) 

CTri*C0S  (  THETA  ) 
ars*thetapri*e 

PH  1R * P H  1  (  RAO) 

ASPECT 

I  3  NAPE  *0  *  1 » 2  *  OR  3 

RCkO 

C(24) 

HC  24) 

OUTPUTS  ARG1*REAL  PART 

AA 62 *IM AGINARY  part 
ICCUNT*NO.OF  PHIP.3IPE  POINTS 
C0HM0N/9LUE/ASP  ECT » I  $H A  P  e 
CCMMON/UHT/C<24  >,W<  cO 

COMNON/6REY/9»6fR,a»CR,ICOUNT,STH,CTM,PI 

COPMON/PINK/ROnC.PHIR 

$*$  IN( ARG) 

CO»COS(ARG) 

COCTH=CO*CTH 


/  43 


S  ST H*S  *  STH 

N*1 ♦INT(PI-S/ ( 1 oO . *S«OR)  ) 

NNN  N*N 
ARG 1*0 .3 
ARG2*G.O 
ARG11»C.O 
ARG12»0.0 
1  COUNT  * J 

IF ( 1SHAPE .  E  tt  •  u  .  CR • 1 S  H  A  P  £  .EG  .  2 )  GO  TO  604 
IF CISWAPE .EQ.1 )  GO  TO  605 
ARG3sSQRT(0.5«PI*RC<0/ASP=CT)«S 
If  (Phl.9  .ES.C.O)  SO  TO  606 
ARG3*ARGJ*ASPSCT 
60  TO  606 

6C4  I  F  ( ISNAPE • c fi • 0 )  ARGJ*$Q 9 T C 2 . C * AC* 0 )  •  S 

1  F  ( I  Shape  .£  S.3 )  AR63*P.5*PI*R0nG*<1  .0-CO) 

IF (ISHAPE.fS. 3. and. S.IE.O.G1 )  AR U3*n . 25 *P I ♦70<C* ( *R G **2  ) 


GO  TO  606 


TV  ,'io . 
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iit  00  ail  * 

30  i  1  7  **•*  ,2 
3KA  Y  *f  LQ AT  A  O 

CCS.NU*C0CTH*SSTn«CO5(PhIP«I' 

CALL  FC7?m  cos  SU.VALl  ,VAL2) 
Ir(ISHA?e.£L.C.Ca.ISHAP5.=a.33  30  TO  607 
:?p;=cos<3h:?ri) 
spri*s:n(?hi?ri ) 

AP5  —  *AP53*CPRI 
AS3i=ARG3»SPRI 
I?(ISHAPS.ea.n  50  TO  i12 
IF (PhlR.EQ.C.O)  50  TO  616 
ARS5*ARS5/AS?SC  T 
50  TO  612 


61  6 

A‘*3  5*APG5  *ASPEC  T 

612 

IF  (ARGA.ES.C.O)  SO  TO 

0  3  *  S  I N  (  A  *  G  i  )  /  A  R  5A 

50  TO  609 

60S 

63a 

CO*  1  ,C 

6C9 

I  ? (ARS5  .£3.0.0)  50  TO 
30  =  00*SINCA3G5)  /AR65 

610 

6 1 C 

FAC=C0G**2)*«(I) 

50  TO  !U 

607 

F A  C  =• C  I  ) 

6  1  « 

AR51=ASS1  *FAC  •'J  ALl 

617 

Ak52*ARG2*F  A  C  *  V  al2 

oC  3 

CONTINUE 

IC0UNT*IC9UNT*1 
IFCL.cfi.3)  30  TC  621 
A  *A  -3 

626  CONTINUE 
F  AC  =S*S 

IF(l.E3 .1 1  50  TO  6  2s 
L  =  3 

AftS11  =  A.?S1«FAC 
APG12=AR32*fac 
A RG 1*0.0 
A *5  2=0 .0 
3  *  d  W  £  F  S 
A  *0 .3*6 
N ft  N  =  1 
GO  TO  625 
621  FAC=3*S 

A.R5l*AB51*FAC*AR€l1 
aSG2=a»52»Fac*AAG12 
50  TO  629 
62!  4PS1*A.RG1  *F  AC 
AS32*AS62  *  F AC 

6  2  9  I  F  (  I  SHAPE  1  .  CP  .  UH  AP;  .  =  3  .  £)  50  TO  61! 
IFUA63. 59.0.0  GO  TO  SO 
I F ( I s  h A  PE . E  0 . ; )  0  0  =  2  .  ”>3  3  S  L  (  m  R  3  3  ,  3  )  /  »  R  5  3 
IFCShAPS.EU.3)  3  '*SI  v  (  ARC  3  >  /  »  <3  3 
37*3C»*2 
GO  r 0  «  j 2 
id  ::*i.c 
i0  2  CONTINUE 

3-16 


a  IN  44 


™  Vo. 
791132 
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23-08:55 :39-<0,) 

S U3  ROUT  I N £  KT»hI  (COSNU.VAlI  ,V  Al2) 

C  THIS  $U8P«06RAfl  COMPUTES  TW£  PHIPRINS  iNTeSPANO. 
C  INPUTS  CCSNU 

C  ~  VALUEK225) 

C  .  VAlU£2<225) 

C  OUTPUTS  V  A  Li *R  £ AL  PART 

C  V Al2*INA6INARY  PART 

ccmmon/red/valuei (24C) *  V  A  L  J  £  2  < 240) 
SNU-ACQS(COSNU) 

C*1  ,GE04*€NU 
I  »  I  ft  T  <  C  ) 

IF  d.GT.O).  60  TC  500 
VAL1*VALUE1 (1 ) 

VAL2*VALUE2(1) 

K  £T Ufl N 

'  SOU'  IFCi.XT~.1C)  GO  ~T0  5C2 
lFCI.6e.1C0)  SO  TO  501 
C  *1 000 • *6NU*9  , 

GO  TO  506 

501  IF<I.6E. 10000)  GO  TO  504 
C  *  1 0Q.*6NU+19* 

- G"0  T0~'5'06‘  - 

504  IFd.GE. 31400)  GO  TO  5C7 
C  =5  0 . *GNU *63  . 

60  TO  506 

507  VAL1*VALUE1 <225  ) 
val2*VALU£2 (225  ) 

RETURN  .  •> 

506  1*1 N TEC) 

502  CII*C-FLOAT(I) 

VAL1»VALU£1  (I ) 

VALlsVALl+(VALUs1(d1)-VALl)*(CII) 

VAL2=VALUE2(I) 

VAl23VAL2*<VALUE2(I+1)-VAL2)*(CII) 

RETURN 

ESO 


£XP(JKR).*I  (COSNU)  • 
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A*S1  =  A»S1  *.0 
<■» i :*A?S2  *3 
C,  1  3  at  TUBS 
r\3 
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alN  Al 
)RaLOT 

23-03:55 :S3-(0,) 

SUS  ROUTINE  MM$  T  C3(Tfi6TA,B0G,S0GAP) 

PARAMETER  HPTS*  200 
C  PETER  R  MINER  APR  197? 

CCNM0N/TAN/RAN6E 

COMMON /BLUE /ASPECT,  I  SHAPE 

COMMON  / PURPLE/  NPOINT, /ARRAY INPTS) .YARRAY (MPTS )  ,Z ARRAY  (*PTS> 

COMMON/  00  RAQ/  C  Hi  S8  ,  At.  f  AR  0 , 0  OWNS  R  ,  5  A  I N  ,  F  A  $  E  ,  N  A  P  f  AC 

CONMON/PINIC/RGX  si,  ph  i r 

NP0INT*NP0INT+-1 

IF(NPOINT.GT.MPTS)  GO  TO  50 

X  ARRAY (NPOINT)* THETA 

YARRAY (NPOINT) *  SD6 

ZARRAY (NPOINT) *bOSA? 

RETURN 

50  GRITEC4,20CC> 

2000"  formats  plot  storage  overflow') 
npoint=«pts 

RETURN 

c 

C  PLOT  CURVE 

ENTRY  NMPL0T 
CALL  N03.R  3 R 

IF(NAPFAC.Sa.O)  SO  TO  1C1 

CALL  T  I  TLE  (  '  ',-1, 'THETA  (  BEG)  '  ,  1 1  , 'SOGAP  C  09  )  '  ,  1  0  ,  9  .  ,  7  .*) 

GO  TO  102 

1C1  CALL  TITLE ( '  ',-lt'THETA  ( 0 £ G )  ' , 1 1 , '0OG  C  00  )  '  ,  S  ,  9  .  ,  7  . ) 

102  CALL  NOCHEA 
CALL  FRAME 

CALL  SR A F (-45.,  10 . , 45 . , -70 . , 10 . , 0 . ) 

CALL  XTICKS(’) 

CALL  YTICAS  (2) 

C  CALL  OOT 

C  CALL  SR  19  (  2  •  1 ) 

C  CALL  RESET('OOT') 

IF (NAPFAC  .  E  4  »  0 )  GO  TO  103 

CALL  CURVE (XARR AY, 2ARRAY,NPOINT,0) 

50  TO  104 

103  CALL  CURVE ( XARR AY , YARRAY, NPOINT, 0) 

104  OC  100  1*1 , NPOINT 
XARRAY ( I ) s-XARfi  AY ( I ) 

100  CONTINUE 

I F (NAPFAC  .25.0)  SO  TO  105 

CALL  CURVE (XARR AY, ZARRAY,NPOINT,C) 

GO  TO  1C6 

105  CALL  CURVE (XARR AY , YARRAY, NPOINT, 0) 

C  . 

C  PLOT  VARIABLES 

IGo  IsISH4?£*1 

GO  TO  (153,160,  170,130)  ,  I 
ISO  CALL  MESS  AG < 'C I ACLE'.6 , .5 ,6.4) 

60  TO  200 

160  CALl  NesSAGC'iiLARS',*.,. 5*6.3) 

GO  TO  200 

170  CALL  MESS  AG  ('RECTANGLE ',9 ,  .5  ,6  .3 ) 

GO  TO  200 


TM  No. 
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.L  ,  791132 

>  CALL  H  E  3  3  A  G  (  :  'i  j  f  I  ^  i  ,7, .5,5.63 
23C  CALL  *=S 3Ai (  '3  A  :n  *  ',T,.*,5.*3 
avalls »<aA  in 

CALL  REALNOUvAlUS,  1C3,'A3u-T',6.5> 

CALL  l-SSSAGk'  3a',3,'A5uT',o.53 
CALL  *£SSAG ( '»k a$«  =  ',3, .5,6.2) 
A7ALUeafA3E 

C A cL  »£AL.NOlAVALUe,1C3,'ASU7',6.23 
CALL  l»£SSAG('  3  2G'*<.t'A3LT'»5»£3 
i?i;SHAP£  ,N£.2i  GC  TO  25C 
CALL  "SSSAS I'AiPSCT  »  ',9, .5, 5.93 
A *AlL£»ASP£CT 

CALL  RcALN0UVAtUS,105,'A8Ur',5.9) 
call  WSSSASI'PhI  *  ',4, .5,5.6) 

IFIPHIR  .SQ.U.3  aWALU2»0. 

IF  (  ?h  1 R  •  N  £  «  G  »  3  AVAL'JfisOO. 

call  REalnOCAVALUS. 102, '*9uT', 5.63 

CALL‘*eSSA5('  0 £G ", 4 j ' A3 b T' , 5 . 6 ) 

C 

c  plot  variaolcS,  right  sioe 

25C  CALL  PSSSAGt'Chl  »  ',6, 6. 5, 6.5) 

A  V  ALUE  *CH I  0  9 

CALL  S6ALN0(AVALUc,103,'A9UT',o.5) 

CALL  .»SSSAG(''  0a',3','A;UT',6  .3) 

CALL  «£S3aG('AL?AR:  -  '.9.6.  it o.5) 

A  V  ALU£*.\L F  A  RC 

CAwl  RSAL'»0CAVALUc,1C6  ,  'A  IDT',  6. 5  ) 

CALL  *  6  S  S  A  G  l  '  39',I ,'AcUT' ,6 .5 > 

CAU.  NSSSAG  C'eO/F  *  '.7. 6. 5. 6. 2) 

AV  ALliS*DOWNSa 

CAuL  RSAL.'O(AVALUS,103,'A3UT',3.2) 

Call  H£SSA3C'RC*0  =  ',7, 6. 5, 5. 93 
a,AlU£sROkO 

C*LL  R£ALNO(AVAlUc,1S5,'A3LT',5.93 
If  (RAflGS.LT, 3. 3iC)  30  TO  210 
CALL  *sSSAGC'S/Ra  *  ',7,6.5,3.63 
A , ALu£=RAH5c 

CAuL  3SALS0  IAV  AUJS  ,  104  ,'ASvJ-!"  ,  5 .03 
•3  0  TO  2  2C 

211  Call  "SSSAS  I'IN  FINITE  PANGS', 14, 6. 5, 5. 6) 
220  CALL  £NC?L<-1) 

RETURN 
2  N  0 
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